home *** CD-ROM | disk | FTP | other *** search
/ La Bible Des… Fonts / La Bible des... Fonts.iso / Utilitaires / Mac GS Viewer 1.0 / files / bdftops.ps < prev    next >
Text File  |  1995-04-24  |  23KB  |  794 lines
  1. %    Copyright (C) 1990, 1995 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % bdftops.ps
  19. % Convert a BDF file (possibly with (an) associated AFM file(s))
  20. % to a PostScript Type 1 font (without eexec encryption).
  21. % The resulting font will work with any PostScript language interpreter,
  22. % but not with ATM or other font rasterizers lacking a complete interpreter.
  23.  
  24. /envBDF 120 dict def
  25. envBDF begin
  26.  
  27. % "Import" the image-to-path package.
  28. % This also brings in the Type 1 opcodes (type1ops.ps).
  29.    (impath.ps) run
  30.  
  31. % "Import" the font-writing package.
  32.    (wrfont.ps) run
  33.    wrfont_dict begin
  34.      /binary_CharStrings false def
  35.      /binary_tokens false def
  36.      /encrypt_CharStrings true def
  37.      /standard_only true def
  38.    end
  39.    /lenIV 0 def
  40.  
  41. % Invert the StandardEncoding vector.
  42.    256 dict dup begin
  43.    0 1 255 { dup StandardEncoding exch get exch def } for
  44.    end /StandardDecoding exch def
  45.  
  46. % Define the properties copied to FontInfo.
  47.    mark
  48.      (COPYRIGHT) /Notice
  49.      (FAMILY_NAME) /FamilyName
  50.      (FULL_NAME) /FullName
  51.      (WEIGHT_NAME) /Weight
  52.    .dicttomark /properties exch def
  53.  
  54. % Define the character sequences for synthesizing missing composite
  55. % characters in the standard encoding.
  56.    mark
  57.      /AE [/A /E]
  58.      /OE [/O /E]
  59.      /ae [/a /e]
  60.      /ellipsis [/period /period /period]
  61.      /emdash [/hyphen /hyphen /hyphen]
  62.      /endash [/hyphen /hyphen]
  63.      /fi [/f /i]
  64.      /fl [/f /l]
  65.      /germandbls [/s /s]
  66.      /guillemotleft [/less /less]
  67.      /guillemotright [/greater /greater]
  68.      /oe [/o /e]
  69.      /quotedblbase [/comma /comma]
  70.    .dicttomark /composites exch def
  71.  
  72. % Define the procedure for synthesizing composites.
  73. % This must not be bound.
  74.    /compose
  75.     { exch pop
  76.       FontMatrix Private /composematrix get invertmatrix concat
  77.       0 0 moveto
  78.       dup gsave false charpath pathbbox currentpoint grestore
  79.       6 2 roll setcachedevice show
  80.     } def
  81. % Define the CharString procedure that calls compose, with the string
  82. % on the stack.  This too must remain unbound.
  83.    /compose_proc
  84.     { Private /compose get exec
  85.     } def
  86.  
  87. % Define aliases for missing characters similarly.
  88.    mark
  89.      /acute /quoteright
  90.      /bullet /asterisk
  91.      /cedilla /comma
  92.      /circumflex /asciicircum
  93.      /dieresis /quotedbl
  94.      /dotlessi /i
  95.      /exclamdown /exclam
  96.      /florin /f
  97.      /fraction /slash
  98.      /grave /quoteleft
  99.      /guilsinglleft /less
  100.      /guilsinglright /greater
  101.      /hungarumlaut /quotedbl
  102.      /periodcentered /asterisk
  103.      /questiondown /question
  104.      /quotedblleft /quotedbl
  105.      /quotedblright /quotedbl
  106.      /quotesinglbase /comma
  107.      /quotesingle /quoteright
  108.      /tilde /asciitilde
  109.    .dicttomark /aliases exch def
  110.  
  111. % Define overstruck characters that can be synthesized with seac.
  112.    mark
  113.     [ /Aacute /Acircumflex /Adieresis /Agrave /Aring /Atilde
  114.       /Ccedilla
  115.       /Eacute /Ecircumflex /Edieresis /Egrave
  116.       /Iacute /Icircumflex /Idieresis /Igrave
  117.       /Lslash
  118.       /Ntilde
  119.       /Oacute /Ocircumflex /Odieresis /Ograve /Otilde
  120.       /Scaron
  121.       /Uacute /Ucircumflex /Udieresis /Ugrave
  122.       /Yacute /Ydieresis
  123.       /Zcaron
  124.       /aacute /acircumflex /adieresis /agrave /aring /atilde
  125.       /ccedilla
  126.       /eacute /ecircumflex /edieresis /egrave
  127.       /iacute /icircumflex /idieresis /igrave
  128.       /lslash
  129.       /ntilde
  130.       /oacute /ocircumflex /odieresis /ograve /otilde
  131.       /scaron
  132.       /uacute /ucircumflex /udieresis /ugrave
  133.       /yacute /ydieresis
  134.       /zcaron
  135.     ]
  136.     { dup =string cvs
  137.       [ exch dup 0 1 getinterval cvn
  138.     exch dup length 1 sub 1 exch getinterval cvn
  139.       ]
  140.     } forall
  141.      /cent [/c /slash]
  142.      /daggerdbl [/bar /equal]
  143.      /divide [/colon /hyphen]
  144.      /sterling [/L /hyphen]
  145.      /yen [/Y /equal]
  146.    .dicttomark /accentedchars exch def
  147.  
  148. % ------ Output utilities ------ %
  149.  
  150.    /ws {psfile exch writestring} bind def
  151.    /wl {ws (\n) ws} bind def
  152.    /wt {=string cvs ws ( ) ws} bind def
  153.  
  154. % ------ BDF file parsing utilities ------ %
  155.  
  156. % Define a buffer for reading the BDF file.
  157.    /buffer 400 string def
  158.  
  159. % Read a line from the BDF file into the buffer.
  160. % Ignore empty (zero-length) lines.
  161. % Define /keyword as the first word on the line.
  162. % Define /args as the remainder of the line.
  163. % If the keyword is equal to commentword, skip the line.
  164. % (If commentword is equal to a space, never skip.)
  165.    /nextline
  166.     {  { bdfile buffer readline not
  167.       { (Premature EOF\n) print stop } if
  168.      dup length 0 ne { exit } if pop     
  169.        }
  170.       loop
  171.       ( ) search
  172.        { /keyword exch def pop }
  173.        { /keyword exch def () }
  174.       ifelse
  175.       /args exch def
  176.       keyword commentword eq { nextline } if
  177.     } bind def
  178.  
  179. % Get a word argument from args.  We do *not* copy the string.
  180.    /warg        % warg -> string
  181.     { args ( ) search
  182.        { exch pop exch }
  183.        { () }
  184.       ifelse  /args exch def
  185.     } bind def
  186.  
  187. % Get an integer argument from args.
  188.    /iarg        % iarg -> int
  189.     { warg cvi
  190.     } bind def
  191.  
  192. % Get a numeric argument from args.
  193.    /narg        % narg -> int|real
  194.     { warg cvr
  195.       dup dup cvi eq { cvi } if
  196.     } bind def
  197.  
  198. % Convert the remainder of args into a string.
  199.    /remarg        % remarg -> string
  200.     { args copystring
  201.     } bind def
  202.  
  203. % Get a string argument that occupies the remainder of args.
  204.    /sarg        % sarg -> string
  205.     { args (") anchorsearch
  206.        { pop /args exch def } { pop } ifelse
  207.       args args length 1 sub get (") 0 get eq
  208.        { args 0 args length 1 sub getinterval /args exch def } if
  209.       args copystring
  210.     } bind def
  211.  
  212. % Check that the keyword is the expected one.
  213.    /checkline        % (EXPECTED-KEYWORD) checkline ->
  214.     { dup keyword ne
  215.        { (Expected ) print =
  216.          (Line=) print keyword print ( ) print args print (\n) print stop
  217.        } if
  218.       pop
  219.     } bind def
  220.  
  221. % Read a line and check its keyword.
  222.    /getline        % (EXPECTED-KEYWORD) getline ->
  223.     { nextline checkline
  224.     } bind def
  225.  
  226. % Find the first/last non-zero bit of a non-zero byte.
  227.    /fnzb
  228.     { 0 { exch dup 128 ge { pop exit } { dup add exch 1 add } ifelse }
  229.       loop
  230.     } bind def
  231.    /lnzb
  232.     { 7 { exch dup 1 and 0 ne { pop exit } { -1 bitshift exch 1 sub } ifelse }
  233.       loop
  234.     } bind def
  235.  
  236. % ------ Type 1 encoding utilities ------ %
  237.  
  238. % Parse the side bearing and width information that begins a CharString.
  239. % Arguments: charstring.  Result: sbx sby wx wy substring.
  240.    /parsesbw
  241.     { mark exch lenIV
  242.        {        % stack: mark ... string dropcount
  243.          dup 2 index length exch sub getinterval
  244.      dup 0 get dup 32 lt { pop exit } if
  245.      dup 246 le
  246.       { 139 sub exch 1 }
  247.       { dup 250 le
  248.          { 247 sub 8 bitshift 108 add 1 index 1 get add exch 2 }
  249.          { dup 254 le
  250.         { 251 sub 8 bitshift 108 add 1 index 1 get add neg exch 2 }
  251.         { pop dup 1 get 128 xor 128 sub
  252.           8 bitshift 1 index 2 get add
  253.           8 bitshift 1 index 3 get add
  254.           8 bitshift 1 index 4 get add exch 5
  255.         } ifelse
  256.          } ifelse
  257.       } ifelse
  258.        } loop
  259.       counttomark 3 eq { 0 3 1 roll 0 exch } if
  260.       6 -1 roll pop
  261.     } bind def 
  262.  
  263. % Find the side bearing and width information that begins a CharString.
  264. % Arguments: charstring.  Result: charstring sizethroughsbw.
  265.    /findsbw
  266.     { dup parsesbw 4 { exch pop } repeat skipsbw
  267.     } bind def
  268.    /skipsbw        % charstring sbwprefix -> sizethroughsbw
  269.     { length 1 index length exch sub
  270.       2 copy get 12 eq { 2 } { 1 } ifelse add
  271.     } bind def
  272.  
  273. % Encode a number, and append it to a string.
  274. % Arguments: str num.  Result: newstr.
  275.    /concatnum
  276.     { dup dup -107 ge exch 107 le and
  277.        { 139 add 1 string dup 0 3 index put }
  278.        { dup dup -1131 ge exch 1131 le and
  279.           { dup 0 ge { 16#f694 } { neg 16#fa94 } ifelse add
  280.         2 string dup 0 3 index -8 bitshift put
  281.         dup 1 3 index 255 and put
  282.       }
  283.       { 5 string dup 0 255 put exch
  284.         2 copy 1 exch -24 bitshift 255 and put
  285.         2 copy 2 exch -16 bitshift 255 and put
  286.         2 copy 3 exch -8 bitshift 255 and put
  287.         2 copy 4 exch 255 and put
  288.         exch
  289.       }
  290.      ifelse
  291.        }
  292.       ifelse exch pop concatstrings
  293.     } bind def
  294.  
  295. % ------ Point arithmetic utilities ------ %
  296.  
  297.    /ptadd { exch 4 -1 roll add 3 1 roll add } bind def
  298.    /ptexch { 4 2 roll } bind def
  299.    /ptneg { neg exch neg exch } bind def
  300.    /ptpop { pop pop } bind def
  301.    /ptsub { ptneg ptadd } bind def
  302.  
  303. % ------ The main program ------ %
  304.  
  305.    /readBDF        % <infilename> <outfilename> <fontname>
  306.             %   <encodingname> <uniqueID> <xuid> readBDF -> <font>
  307.     { /xuid exch def        % may be null
  308.       /uniqueID exch def    % may be -1
  309.       /encodingname exch def
  310.     /encoding encodingname cvx exec def
  311.       /fontname exch def
  312.       /psname exch def
  313.       /bdfname exch def
  314.       gsave        % so we can set the CTM to the font matrix
  315.  
  316. %  Open the input files.  We don't open the output file until
  317. %  we've done a minimal validity check on the input.
  318.       bdfname (r) file /bdfile exch def
  319.       /commentword ( ) def
  320.  
  321. %  Check for the STARTFONT.
  322.       (STARTFONT) getline
  323.       args (2.1) ne { (Not version 2.1\n) print stop } if
  324.  
  325. %  Initialize the font.
  326.       /Font 20 dict def
  327.       Font begin
  328.       /FontName fontname def
  329.       /PaintType 0 def
  330.       /FontType 1 def
  331.       uniqueID 0 gt { /UniqueID uniqueID def } if
  332.       xuid null ne { /XUID xuid def } if
  333.       /Encoding encoding def
  334.       /FontInfo 20 dict def
  335.       /Private 20 dict def
  336.       currentdict end currentdict end
  337.       exch begin begin        % insert font above environment
  338.  
  339. %  Initialize the Private dictionary in the font.
  340.       Private begin
  341.       /-! {string currentfile exch readhexstring pop} readonly def
  342.       /-| {string currentfile exch readstring pop} readonly def
  343.       /|- {readonly def} readonly def
  344.       /| {readonly put} readonly def
  345.       /BlueValues [] def
  346.       /lenIV lenIV def
  347.       /MinFeature {16 16} def
  348.       /password 5839 def
  349.       /UniqueID uniqueID def
  350.       end        % Private
  351.  
  352. %  Invert the Encoding, for synthesizing composite characters.
  353.       /decoding encoding length dict def
  354.       0 1 encoding length 1 sub
  355.        { dup encoding exch get exch decoding 3 1 roll put }
  356.       for
  357.  
  358. %  Now open the output file.
  359.       psname (w) file /psfile exch def
  360.  
  361. %  Put out a header compatible with the Adobe "standard".
  362.       (%!FontType1-1.0: ) ws fontname wt (000.000) wl
  363.       (% This is a font description converted from ) ws
  364.     bdfname wl
  365.       (%   by bdftops running on ) ws
  366.       statusdict /product get ws ( revision ) ws
  367.       revision =string cvs ws (.) wl
  368.  
  369. %  Copy the initial comments, up to FONT.
  370.       true
  371.        { nextline
  372.      keyword (COMMENT) ne {exit} if
  373.       { (% Here are the initial comments from the BDF file:\n%) wl
  374.       } if false
  375.      (%) ws remarg wl
  376.        } loop pop
  377.       () wl
  378.       /commentword (COMMENT) def    % do skip comments from now on
  379.  
  380. %  Read and process the FONT, SIZE, and FONTBOUNDINGBOX.
  381.       % If we cared about FONT, we'd use it here.  If the BDF files
  382.       % from MIT had PostScript names rather than X names, we would
  383.       % care; but what's there is unusable, so we discard FONT.
  384.       % The FONTBOUNDINGBOX may not be reliable, so we discard it too.
  385.       (FONT) checkline
  386.       (SIZE) getline
  387.     /pointsize iarg def   /xres iarg def   /yres iarg def
  388.       (FONTBOUNDINGBOX) getline
  389.       nextline
  390.  
  391. %  Initialize the font bounding box bookeeping.
  392.       /fbbxo 1000 def
  393.       /fbbyo 1000 def
  394.       /fbbxe -1000 def
  395.       /fbbye -1000 def
  396.  
  397. %  Read and process the properties.  We only care about a few of them.
  398.       keyword (STARTPROPERTIES) eq
  399.        { iarg
  400.           { nextline
  401.         properties keyword known
  402.          { FontInfo properties keyword get sarg readonly put
  403.          } if
  404.       } repeat
  405.          (ENDPROPERTIES) getline
  406.      nextline
  407.        } if
  408.  
  409. %  Compute and set the FontMatrix.
  410.       Font /FontMatrix
  411.        [ 0.001 0 0 0.001 xres mul yres div 0 0 ] readonly
  412.       dup setmatrix put
  413.  
  414. %  Read and process the header for the bitmaps.
  415.       (CHARS) checkline
  416.     /ccount iarg def
  417.  
  418. %  Initialize the CharStrings dictionary.
  419.       /charstrings ccount
  420.     composites length add
  421.     aliases length add
  422.     accentedchars length add
  423.     1 add dict def        % 1 add for .notdef
  424.       /isfixedwidth true def
  425.       /fixedwidth null def
  426.       /subrcount 0 def
  427.       /subrs [] def
  428.  
  429. %  Read the bitmap data.  This reads the remainder of the file.
  430. %  We do this before processing the bitmaps so that we can compute
  431. %  the correct FontBBox first.
  432.       /chardata ccount dict def
  433.       ccount -1 1
  434.        { (STARTCHAR) getline
  435.            /charname remarg def
  436.      (ENCODING) getline
  437.        /eindex iarg def
  438.        eindex 0 ge
  439.         { charname /charname StandardEncoding eindex get def
  440.           charname /.notdef eq eindex 0 gt and
  441.            { /charname (A) eindex =string cvs concatstrings cvn def
  442.            }
  443.           if
  444.           (/) print charname =string cvs print (,) print print
  445.         }
  446.         { (/) print charname print
  447.         }
  448.        ifelse
  449.        10 mod 1 eq { (\n) print flush } if
  450.      (SWIDTH) getline
  451.        /swx iarg pointsize mul 1000 div xres mul 72 div def
  452.        /swy iarg pointsize mul 1000 div xres mul 72 div def
  453.      (DWIDTH) getline        % Ignore, use SWIDTH instead
  454.      (BBX) getline
  455.        /bbw iarg def  /bbh iarg def  /bbox iarg def  /bboy iarg def
  456.      nextline
  457.      keyword (ATTRIBUTES) eq
  458.       { nextline
  459.       } if
  460.      (BITMAP) checkline
  461.  
  462. % Update the font bounding box.
  463.      /fbbxo fbbxo bbox min def
  464.      /fbbyo fbbyo bboy min def
  465.      /fbbxe fbbxe bbox bbw add max def
  466.      /fbbye fbbye bboy bbh add max def
  467.  
  468. % Read the bits for this character.
  469.      /raster bbw 7 add 8 idiv def
  470.      /cbits raster bbh mul string def
  471.      0 raster cbits length raster sub
  472.       { cbits exch raster getinterval
  473.         bdfile buffer readline not
  474.          { (EOF in bitmap\n) print stop } if
  475.         % stack has <cbits.interval> <buffer.interval>
  476.         0 () /SubFileDecode filter
  477.         exch 2 copy readhexstring pop pop pop closefile
  478.       } for
  479.      (ENDCHAR) getline
  480.  
  481. % Save the character data.
  482.      chardata charname [swx swy bbw bbh bbox bboy cbits] put
  483.        } for
  484.  
  485.       (ENDFONT) getline
  486.  
  487. % Allocate the buffers for the bitmap and the outline,
  488. % according to the font bounding box.
  489.       /fbbw fbbxe fbbxo sub def
  490.       /fbbh fbbye fbbyo sub def
  491.       /fraster fbbw 7 add 8 idiv def
  492.       /bits fraster fbbh mul 200 max 65535 min string def
  493.       /outline bits length 6 mul 65535 min string def
  494.  
  495. %  Process the characters.
  496.       chardata
  497.        { exch /charname exch def  aload pop
  498.      /cbits exch def
  499.      /bboy exch def   /bbox exch def
  500.      /bbh exch def   /bbw exch def
  501.      /swy exch def   /swx exch def
  502.  
  503. % The bitmap handed to type1imagepath must have the correct height,
  504. % because type1imagepath uses this to compute the scale factor,
  505. % so we have to clear the unused parts of it.
  506.      /raster bbw 7 add 8 idiv def
  507.      bits dup 0 1 raster fbbh mul 1 sub
  508.       { 0 put dup } for
  509.      pop pop
  510.      bits raster fbbh bbh sub mul cbits putinterval
  511.  
  512. %  Compute the font entry, converting the bitmap to an outline.
  513.      bits 0 raster fbbh mul getinterval    % the bitmap image
  514.      bbw   fbbh                % bitmap width & height
  515.      swx   swy                % width x & y
  516.      bbox neg   bboy neg            % origin x & y
  517.          % Account for lenIV when converting the outline.
  518.      outline  lenIV  outline length lenIV sub  getinterval
  519.      type1imagepath
  520.      length lenIV add
  521.      outline exch 0 exch getinterval
  522.  
  523. % Check for a fixed width font.
  524.      isfixedwidth
  525.       { fixedwidth null eq
  526.          { /fixedwidth swx def }
  527.          { fixedwidth swx ne { /isfixedwidth false def } if }
  528.         ifelse
  529.       } if
  530.  
  531. % Finish up the character.
  532.      copystring
  533.      charname exch charstrings 3 1 roll put
  534.        } forall
  535.  
  536. %  Add CharStrings entries for aliases.
  537.       aliases
  538.        { charstrings 2 index known not charstrings 2 index known and
  539.           { charstrings exch get charstrings 3 1 roll put
  540.       }
  541.       { pop pop
  542.       }
  543.      ifelse
  544.        }
  545.       forall
  546.  
  547. %  If this is not a fixed-width font, synthesize missing characters
  548. %  out of available ones.
  549.       isfixedwidth not
  550.        { false composites
  551.       { 1 index charstrings exch known not
  552.         1 index { decoding exch known and } forall
  553.          { ( /) print 1 index bits cvs print
  554.            /combine exch def
  555.            0 1 combine length 1 sub
  556.         { dup combine exch get decoding exch get
  557.           bits 3 1 roll put
  558.         } for
  559.            bits 0 combine length getinterval copystring
  560.            [ exch /compose_proc load aload pop ] cvx
  561.            charstrings 3 1 roll put
  562.            pop true
  563.          }
  564.          { pop pop }
  565.         ifelse
  566.       }
  567.      forall flush
  568.       { Private /composematrix matrix put
  569.         Private /compose /compose load put
  570.       }
  571.      if
  572.        }
  573.       if
  574.  
  575. %  Synthesize accented characters with seac if needed and possible.
  576.       accentedchars
  577.        { aload pop /accent exch def /base exch def
  578.          buffer cvs /accented exch def
  579.      charstrings accented known not
  580.      charstrings base known and
  581.      charstrings accent known and
  582.      StandardDecoding base known and
  583.      StandardDecoding accent known and
  584.      encoding StandardDecoding base get get base eq and
  585.      encoding StandardDecoding accent get get accent eq and
  586.       { ( /) print accented print
  587.         charstrings base get findsbw 0 exch getinterval
  588.         /acstring exch def        % start with sbw of base
  589.         charstrings accent get parsesbw
  590.         4 { pop } repeat        % just leave sbx
  591.         acstring exch concatnum
  592.         0 concatnum 0 concatnum        % adx ady
  593.         decoding base get concatnum        % bchar
  594.         decoding accent get concatnum    % achar
  595.         s_seac concatstrings
  596.         charstrings exch accented copystring exch put
  597.       } if
  598.        } forall
  599.  
  600. %  Make a CharStrings entry for .notdef.
  601.       outline lenIV <8b8b0d0e> putinterval    % 0 0 hsbw endchar
  602.       charstrings /.notdef outline 0 lenIV 4 add getinterval copystring put
  603.  
  604. %  Encrypt the CharStrings and Subrs (in place).
  605.       charstrings
  606.        {    % Be careful not to encrypt aliased characters twice,
  607.         % since they share their CharString.
  608.      aliases 2 index known
  609.       { charstrings aliases 3 index get .knownget
  610.          { 1 index ne }
  611.          { true }
  612.         ifelse
  613.       }
  614.       { true
  615.       }
  616.      ifelse
  617.      1 index type /stringtype eq and
  618.           { 4330 exch dup .type1encrypt exch pop
  619.         readonly charstrings 3 1 roll put
  620.       }
  621.       { pop pop
  622.       }
  623.      ifelse
  624.        }
  625.       forall
  626.       0 1 subrcount 1 sub
  627.        { dup subrs exch get
  628.      4330 exch dup .type1encrypt exch pop
  629.      subrs 3 1 roll put
  630.        }
  631.       for
  632.  
  633. %  Make most of the remaining entries in the font dictionaries.
  634.  
  635. % The Type 1 font machinery really only works with a 1000 unit
  636. % character coordinate system.  Set this up here, by computing the factor
  637. % to make the X entry in the FontMatrix come out at exactly 0.001.
  638.       /fontscale 1000 fbbh div yres mul xres div def
  639.       Font /FontBBox
  640.        [ fbbxo fontscale mul
  641.      fbbyo fontscale mul
  642.      fbbxe fontscale mul
  643.      fbbye fontscale mul
  644.        ] cvx readonly put
  645.       Font /CharStrings charstrings readonly put
  646.       FontInfo /FullName known not
  647.        { % Some programs insist on FullName being present.
  648.          FontInfo /FullName FontName dup length string cvs put
  649.        }
  650.       if
  651.       FontInfo /isFixedPitch isfixedwidth put
  652.       subrcount 0 gt
  653.        { Private /Subrs subrs 0 subrcount getinterval readonly put
  654.        } if
  655.  
  656. %  Determine the italic angle and underline position
  657. %  by actually installing the font.
  658.       save
  659.       /_temp_ Font definefont setfont
  660.       [1000 0 0 1000 0 0] setmatrix        % mitigate rounding problems
  661. % The italic angle is the multiple of -5 degrees
  662. % that minimizes the width of the 'I'.
  663.       0 9999 0 5 85
  664.        { dup rotate
  665.          newpath 0 0 moveto (I) false charpath
  666.      dup neg rotate
  667.          pathbbox pop exch pop exch sub
  668.      dup 3 index lt { 4 -2 roll } if
  669.      pop pop
  670.        }
  671.       for pop
  672. % The underline position is halfway between the bottom of the 'A'
  673. % and the bottom of the FontBBox.
  674.       newpath 0 0 moveto (A) false charpath
  675.       FontMatrix concat
  676.       pathbbox pop pop exch pop
  677. %  Put the values in FontInfo.
  678.       3 -1 roll
  679.       restore
  680.       Font /FontBBox get 1 get add 2 div cvi
  681.       dup FontInfo /UnderlinePosition 3 -1 roll put
  682.       2 div abs FontInfo /UnderlineThickness 3 -1 roll put
  683.       FontInfo /ItalicAngle 3 -1 roll put
  684.  
  685. %  Clean up and finish.
  686.       grestore
  687.       bdfile closefile
  688.       Font currentdict end end begin        % remove font from dict stack
  689.       (\n) print flush
  690.  
  691.     } bind def
  692.  
  693. % ------ Reader for AFM files ------ %
  694.  
  695. % Dictionary for looking up character keywords
  696.    /cmdict 6 dict dup begin
  697.       /C { /c iarg def } def
  698.       /N { /n warg copystring def } def
  699.       /WX { /w narg def } def
  700.       /W0X /WX load def
  701.       /W /WX load def
  702.       /W0 /WX load def
  703.    end def
  704.  
  705.    /readAFM        % fontdict afmfilename readAFM -> fontdict
  706.     { (r) file /bdfile exch def
  707.       /Font exch def
  708.       /commentword (Comment) def
  709.  
  710. %  Check for the StartFontMetrics.
  711.       (StartFontMetrics) getline
  712.       args cvr 2.0 lt { (Not version 2.0 or greater\n) print stop } if
  713.  
  714. %  Look for StartCharMetrics, then parse the character metrics.
  715. %  The only information we care about is the X width.
  716.       /metrics 0 dict def
  717.        { nextline
  718.          keyword (EndFontMetrics) eq { exit } if
  719.      keyword (StartCharMetrics) eq
  720.       { iarg dup dict /metrics exch def
  721.          { /c -1 def /n null def /w null def
  722.            nextline buffer
  723.         { token not { exit } if
  724.           dup cmdict exch known
  725.            { exch /args exch def   cmdict exch get exec   args }
  726.            { pop }
  727.           ifelse
  728.         } loop
  729.            c 0 ge n null ne or w null ne and
  730.         { n null eq { /n Font /Encoding get c get def } if
  731.           metrics n w put
  732.         }
  733.            if
  734.          }
  735.         repeat
  736.         (EndCharMetrics) getline
  737.       } if
  738.        } loop
  739.  
  740. %  Insert the metrics in the font.
  741.        metrics length 0 ne
  742.     { Font /Metrics metrics readonly put
  743.     } if
  744.       Font
  745.     } bind def
  746.  
  747. end        % envBDF
  748.  
  749. % Enter the main program in the current dictionary.
  750. /bdfafmtops        % infilename afmfilename* outfilename fontname
  751.             %   encodingname uniqueID xuid
  752.  { envBDF begin
  753.      7 -2 roll exch 7 2 roll    % afm* in out fontname encodingname uniqueID xuid
  754.      readBDF        % afm* font
  755.      exch { readAFM } forall
  756.      save exch
  757.      dup /FontName get exch definefont
  758.      setfont
  759.      psfile writefont
  760.      restore
  761.      psfile closefile
  762.    end
  763.  } bind def
  764.  
  765. % If the program was invoked from the command line, run it now.
  766. [ shellarguments
  767.  { counttomark 4 ge
  768.     { dup 0 get
  769.       dup 48 ge exch 57 le and        % last arg starts with a digit?
  770.        { /StandardEncoding }        % no encodingname
  771.        { cvn }                % have encodingname
  772.       ifelse
  773.       exch (.) search            % next-to-last arg has . in it?
  774.        { mark 4 1 roll            % have xuid
  775.           { cvi exch pop exch (.) search not { exit } if }
  776.      loop cvi ]
  777.      3 -1 roll cvi exch
  778.        }
  779.        { cvi null            % no xuid
  780.        }
  781.       ifelse
  782.       counttomark 5 roll
  783.       counttomark 6 sub array astore
  784.       7 -2 roll cvn 7 -3 roll        % make sure fontname is a name
  785.       bdfafmtops
  786.     }
  787.     { cleartomark
  788.       (Usage:\n  bdftops xx.bdf [yy1.afm ...] zz.gsf fontname uniqueID [xuid] [encodingname]\n) print flush
  789.       mark
  790.     }
  791.    ifelse
  792.  }
  793. if pop
  794.